home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tool_wnd / toolbar.bas < prev    next >
BASIC Source File  |  1994-05-25  |  8KB  |  178 lines
  1. Option Explicit
  2. Global QuickInfo        As Integer      ' use QuickInfo
  3. Global ToolhWnd         As Integer      ' is Toolwnd loaded
  4. Global stppx            As Integer      ' Screen.TwipsPerPixelX
  5. Global stppy            As Integer      ' Screen.TwipsPerPixelY
  6. Type apiPoint
  7.     x       As Integer
  8.     Y       As Integer
  9. End Type
  10. Type apiRect
  11.     Left    As Integer
  12.     Top     As Integer
  13.     Right   As Integer
  14.     Bottom  As Integer
  15. End Type
  16.  
  17. Declare Function ExtFloodFill Lib "GDI" (ByVal hDC As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal crColor As Long, ByVal wFillType As Integer) As Integer
  18. Declare Sub GetCursorPos Lib "User" (sPoint As apiPoint)
  19. Global Const MF_BYPOSITION = &H400&
  20. Global Const SrcCopy = &HCC0020
  21.            
  22. Global Const MP_Uhr = 11
  23. Global Const MP_Normal = 0
  24. Global MP_Alt               As Integer
  25.  
  26. Declare Function GetSystemMenu Lib "User" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer
  27. Declare Function RemoveMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
  28. Declare Function GetSystemMetrics Lib "user" (ByVal Param As Integer) As Integer
  29. Declare Function GetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
  30. Declare Function ExtractIcon Lib "Shell.dll" (ByVal hWnd As Integer, ByVal FileName As String, ByVal i As Integer) As Integer
  31. Declare Function DrawIcon Lib "User" (ByVal hDC As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal hIcon As Integer) As Integer
  32. Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
  33. Declare Function GetKeyState Lib "User" (ByVal nVirtKey As Integer) As Integer
  34. Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As apiRect)
  35. Declare Sub SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
  36. Declare Function GetTickCount Lib "user" () As Long
  37. Declare Function StretchBlt Lib "GDI" (ByVal hDC%, ByVal x%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwRop&) As Integer
  38. Declare Function GetSysColor Lib "User" (ByVal nIndex As Integer) As Long
  39. Declare Function CreateDC Lib "GDI" (ByVal Driver$, ByVal Dev&, ByVal O&, ByVal Init&) As Integer
  40. Declare Function DeleteDC Lib "GDI" (ByVal dc As Integer) As Integer
  41. Declare Sub DrawFocusRect Lib "User" (ByVal hDC As Integer, lpRect As apiRect)
  42.  
  43. Sub FakeMove (MyForm As Form)
  44. Dim dc As Integer, dx As Integer, dy As Integer, x As Integer, Y As Integer
  45. Dim mPos As apiPoint, oldPos As apiPoint
  46. Dim mRect As apiRect
  47.     MP_Alt = Screen.MousePointer
  48.     Screen.MousePointer = 1
  49.     dc = CreateDC("DISPLAY", 0, 0, 0)
  50.     dx = MyForm.Width / stppx
  51.     dy = MyForm.Height / stppy
  52.     GetCursorPos mPos
  53.     oldPos = mPos
  54.     GetWindowRect MyForm.hWnd, mRect
  55.     x = mPos.x - mRect.Left
  56.     Y = mPos.Y - mRect.Top
  57.     mRect.Left = mPos.x - x
  58.     mRect.Top = mPos.Y - Y
  59.     mRect.Right = mRect.Left + dx
  60.     mRect.Bottom = mRect.Top + dy
  61.     DrawFocusRect dc, mRect
  62.     Do
  63.         DoEvents
  64.         oldPos = mPos
  65.         GetCursorPos mPos
  66.         If oldPos.x <> mPos.x Or oldPos.Y <> mPos.Y Then
  67.             DrawFocusRect dc, mRect
  68.             mRect.Left = mPos.x - x
  69.             mRect.Top = mPos.Y - Y
  70.             mRect.Right = mRect.Left + dx
  71.             mRect.Bottom = mRect.Top + dy
  72.             DrawFocusRect dc, mRect
  73.         End If
  74.     Loop Until GetKeyState(1) >= 0
  75.     DrawFocusRect dc, mRect
  76.     dc = DeleteDC(dc)
  77.     MyForm.Move stppx * (mPos.x - x), stppy * (mPos.Y - Y)
  78.     MyForm.Cls
  79.     Screen.MousePointer = MP_Alt
  80. End Sub
  81.  
  82. Sub MakeUpperStatusBar (Bar As PictureBox)
  83. Dim OldParentMode As Integer, MyOldMode As Integer, MDICorr As Integer
  84. Dim OldRedraw As Integer, wRect As apiRect
  85.     Bar.Align = 1
  86.     OldRedraw = Bar.AutoRedraw
  87.     Bar.AutoRedraw = True
  88.     Bar.BackColor = RGB(192, 192, 192)
  89.     Bar.BorderStyle = False
  90.     GetWindowRect Bar.hWnd, wRect           '<<<!!!
  91.     MyOldMode = Bar.ScaleMode
  92.     Bar.ScaleMode = 3
  93.     Bar.Line (1, wRect.Bottom - wRect.Top - 2)-(wRect.Right - wRect.Left, wRect.Bottom - wRect.Top - 2), RGB(128, 128, 128)
  94.     Bar.Line (0, 0)-(wRect.Right - wRect.Left, 0), RGB(255, 255, 255)
  95.     Bar.Line (0, 1)-(0, wRect.Bottom - wRect.Top), RGB(255, 255, 255)
  96.     Bar.Line (0, wRect.Bottom - wRect.Top - 1)-(wRect.Right - wRect.Left, wRect.Bottom - wRect.Top - 1), RGB(0, 0, 0)
  97.     If MDICorr = 1 Then
  98.         Bar.Parent.ScaleMode = OldParentMode
  99.     End If
  100.     Bar.ScaleMode = MyOldMode
  101.     Bar.AutoRedraw = OldRedraw
  102. End Sub
  103.  
  104. Sub MenuRight (MyMenu As Control)
  105.     MyMenu.Caption = Chr$(8) + MyMenu.Caption
  106. End Sub
  107.  
  108. Function PutIconToPicture (MyIcon As Control, FileName As String, IconCnt As Integer) As Integer
  109. Dim rc As Integer, iHwnd As Integer
  110.     On Error Resume Next
  111.     MyIcon.AutoRedraw = True
  112.     MyIcon.Picture = LoadPicture("")
  113.     MyIcon.Cls
  114.     MyIcon.ScaleMode = 3
  115.     SetWindowPos MyIcon.hWnd, 0, 0, 0, GetSystemMetrics(11) + 2, GetSystemMetrics(12) + 2, &H2
  116.     iHwnd = GetWindowWord(MyIcon.Parent.hWnd, -6)
  117.     rc = ExtractIcon(iHwnd, FileName, IconCnt)
  118.     rc = DrawIcon(MyIcon.hDC, 0, 0, rc)
  119.     MyIcon.Refresh
  120.     If rc <> 0 Then PutIconToPicture = True
  121. End Function
  122.  
  123. Function ButtonDown (MyButton As Control) As Integer
  124. Dim rc As Integer, mWidth As Integer, mHeight As Integer, rp As Integer, rd As Integer
  125. Dim ButtonState As Integer, ds As Integer, dm As Integer
  126. Dim wPoint As apiPoint, wRect As apiRect
  127.     On Error Resume Next
  128.     MyButton.Cls
  129.     GetWindowRect MyButton.hWnd, wRect
  130.     rd = MyButton.ScaleMode
  131.     ds = MyButton.DrawStyle
  132.     dm = MyButton.DrawMode
  133.     MyButton.ScaleMode = 3
  134.     MyButton.DrawStyle = 0
  135.     MyButton.DrawMode = 13
  136.     mWidth = MyButton.Width
  137.     mHeight = MyButton.Height
  138.     Do
  139.         rc = GetKeyState(1)
  140.         DoEvents
  141.         If rc = 0 Then Exit Do
  142.         If rc = 1 Then Exit Do
  143.         GetCursorPos wPoint
  144.         If wPoint.x < wRect.Left Or wPoint.x > wRect.Right - 1 Or wPoint.Y < wRect.Top Or wPoint.Y > wRect.Bottom Then
  145.             If ButtonState Then MyButton.Cls
  146.             ButtonState = False
  147.         Else
  148.             If ButtonState = False Then
  149.                 rc = BitBlt(MyButton.hDC, 3, 3, mWidth - 4, mHeight - 4, MyButton.hDC, 2, 2, SrcCopy)
  150.                 MyButton.Line (2, 2)-(mWidth - 2, 2), RGB(192, 192, 192)
  151.                 MyButton.Line (2, 3)-(2, mHeight - 2), RGB(192, 192, 192)
  152.                 MyButton.Line (1, 1)-(1, mHeight - 2), RGB(128, 128, 128)
  153.                 MyButton.Line (1, 1)-(mWidth - 2, 1), RGB(128, 128, 128)
  154.                 MyButton.Line (2, mHeight - 2)-(mWidth - 2, mHeight - 2), RGB(192, 192, 192)'RGB(255, 255, 255)
  155.                 MyButton.Line (mWidth - 2, 2)-(mWidth - 2, mHeight - 1), RGB(192, 192, 192)'RGB(255, 255, 255)
  156.             End If
  157.             ButtonState = True
  158.         End If
  159.     Loop
  160.     ButtonDown = ButtonState
  161.     MyButton.ScaleMode = rd
  162.     MyButton.DrawStyle = ds
  163.     MyButton.DrawMode = dm
  164.     MyButton.Cls
  165.     MyButton.Refresh
  166. End Function
  167.  
  168. Sub WaitZehntel (Sec As Integer)
  169. Dim StartTime!, StoppTime!
  170.     StoppTime! = GetTickCount() / 1000
  171.     Do
  172.         StoppTime! = GetTickCount() / 1000
  173.         DoEvents
  174.         If StartTime! + (Sec / 10) <= StoppTime! Then Exit Do
  175.     Loop
  176. End Sub
  177.  
  178.